home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / graphics / amicad / arexx_english / selectnet.amicad < prev    next >
Text File  |  1999-12-06  |  4KB  |  196 lines
  1. /* $VER: NetList 1.02e (© R.Florac, 22-05-99) */
  2.  
  3. options results     /* indispensable pour récupérer le résultat des macros */
  4.  
  5. signal on error     /* pour l'interception des erreurs */
  6. signal on syntax
  7.  
  8. 'FIRSTSEL'; i=result
  9. if result~=0 then do
  10.     'NEXTSEL(FIRSTSEL)'
  11.     if result~=0 then i=0
  12. end
  13.  
  14. if i=0 then do
  15.     'PICKOBJ("Click on the net to check")'
  16.     i=result
  17. end
  18.  
  19. if i<=0 then exit
  20.  
  21. /* Test des liaisons */
  22. j=1; nets=0; net.0=""
  23. 'TITLE("Reading nets..."):LOCK(-1):OBJECTS(-1)'; objets=result
  24.  
  25. /* Initialisation de l'appartenance des objets à une équipotentielle */
  26. net.=-1
  27.  
  28. 'TYPE(O='i')'
  29. if result=2 then do
  30.     'UNMARK(-1):TEST(O)'
  31.     if result=0 then do
  32.     'COORDS(O)'             /* Marquage du fil */
  33.     parse var result x0','y0','x1','y1
  34.     call test_ligne(x0,y0,objets)
  35.     call test_ligne(x1,y1,objets)
  36.     end
  37. end
  38. else do
  39.     'MESSAGE("Incorrect selection"):UNLOCK(-1)'
  40.     exit
  41. end
  42.  
  43. 'TITLE("Test of junctions...")'
  44. m=1
  45. do while m>0
  46.     m=0
  47.     i=1
  48.     do while i>0
  49.     'OO=FINDOBJ('i',7,-1,-1)'; i=result
  50.     if i>0 then do
  51.         'TEST(OO)'
  52.         if result=0 then do
  53.         'COL(OO)'; x0=result
  54.         'LINE(OO)'; y0=result
  55.         n=test_jonction(x0,y0,objets)
  56.         if n=1 then do        /* la jonction appartient au net */
  57.            'MARK(OO)'
  58.             call marquer_ligne(x0,y0,objets)
  59.             m=1
  60.         end
  61.         end
  62.         if i=objets then i=0
  63.         else i=i+1
  64.     end
  65.     end
  66. end
  67.  
  68. 'TITLE("Checking grounds...")'
  69. label=""
  70. do i=1 to objets
  71.     'O=FINDPART('i',"GROUND")'; i=result
  72.     if i>0 then do
  73.     j=connexion_broche(i,1)
  74.     if j>0 then do
  75.         'TEST('j')'
  76.         if result=1 then do
  77.         label=0
  78.         leave i
  79.         end
  80.     end
  81.     i=i+1
  82.     end
  83.     else leave
  84. end
  85.  
  86. if label="" then do
  87.     'TITLE("Looking for labels...")'
  88.     do i=1 to objets
  89.     'TYPE(O='i')'
  90.     if result=4 | result=12 | result=11 then do
  91.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  92.         if j>0 then do
  93.         'TEST('j')'
  94.         if result=1 then do
  95.             'READTEXT(O)'; label=result; leave i
  96.         end
  97.         end
  98.     end
  99.     end
  100. end
  101.  
  102. if label="" then do
  103.     'TITLE("Looking for powers...")'
  104.     do i=1 to objets
  105.     'O=FINDPART('i',"POWER SUPPLY")'; i=result
  106.     if i>0 then do
  107.         j=connexion_broche(i,1)
  108.         if j>0 then do
  109.         'TEST('j')'
  110.         if result=1 then do
  111.             'READTEXT(GETVAL(O))'; label=result; leave i
  112.         end
  113.         end
  114.         i=i+1
  115.     end
  116.     else leave
  117.     end
  118. end
  119.  
  120. 'TITLE("")'
  121. if label~="" then 'MESSAGE("Net 'label'")'
  122. 'UNLOCK(-1)'
  123. exit
  124.  
  125. test_ligne: procedure expose net.
  126.     parse arg x0,y0,objets
  127.     o=1
  128.     do until o=0
  129.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  130.     if o>0 then do
  131.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  132.         if result~=0 then do
  133.         net.o=1
  134.         parse var result x1','y1','x2','y2
  135.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  136.         else call test_ligne(x1,y1,objets)
  137.         end
  138.         if o=objets then return
  139.         o=o+1
  140.     end
  141.     end
  142.     return
  143.  
  144. marquer_ligne: procedure expose net.
  145.     parse arg x0,y0,objets
  146.     o=1
  147.     do until o=0
  148.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  149.     if o>0 then do
  150.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  151.         if result~=0 then do
  152.         net.o=1
  153.         parse var result xl','yl','x1','y1
  154.         call test_ligne(xl,yl,objets)
  155.         call test_ligne(x1,y1,objets)
  156.         end
  157.         if o=objets then return
  158.         o=o+1
  159.     end
  160.     end
  161.     return
  162.  
  163. test_jonction: procedure expose net.
  164.     parse arg xj,yj,objets
  165.     obj=1
  166.     do while obj>0
  167.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  168.     if net.obj=1 then return 1
  169.     if obj=0 then return 0
  170.     if obj=objets then return 0
  171.     obj=obj+1
  172.     end
  173.     return 0
  174.  
  175. connexion_broche: procedure
  176.     parse arg objet,broche
  177.     'PINCOL(O='objet',B='broche')'; xj=result
  178.     'PINLINE(O,B)'; yj=result
  179.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  180.     if xl>0 then return xl
  181.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  182.     if xl<=0 then return 0
  183.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  184.     if result>0 then return xl
  185.     return 0
  186.  
  187. /* Traitement des erreurs, interruption du programme */
  188. syntax:
  189. erreur=RC
  190. 'MESSAGE("Script SelectNet.AmiCAD:"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  191. exit
  192.  
  193. error:
  194. 'MESSAGE("Script SelectNet.AmiCAD:"+CHR(10)+"Error in line 'SIGL'")'
  195. exit
  196.